home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Bavarian
/
Bavarian #129 (19xx)(APS Electronic).zip
/
Bavarian #129 (19xx)(APS Electronic).adf
/
APAINT.MAIN
< prev
next >
Wrap
Text File
|
1986-02-01
|
36KB
|
1,011 lines
100 PRINT " ==== APAINT ==== "
110 PRINT
120 PRINT " Copyright 1985,1986 Colin French "
130 PRINT " Requires: min. 512K, Amiga mouse "
140 PRINT " Latest Revision: 24/02/86 CJF "
150 RETURN
160 PRINT "Although this program is copyrighted,"
170 PRINT "please feel free to pass on copies to"
180 PRINT "friends and user groups, so long as"
190 PRINT "it's not done for profit. All other"
200 PRINT "rights are reserved by the author."
210 RETURN
220 PRINT "APaint uses a number of other files"
230 PRINT "which must be copied along with this"
240 PRINT "main program. Put these files on a"
250 PRINT "bootable disk that contains all the"
260 PRINT "AmigaDOS system files. (For example,"
270 PRINT "a copy of the Workbench disk that has"
280 PRINT "been stripped-down, ie no demo files,"
290 PRINT "font files, etc.) Then boot up with"
300 PRINT "this disk instead of the Workbench."
310 PRINT
320 PRINT "The easiest way to copy APaint is to"
330 PRINT "use the Workbench & copy this entire"
340 PRINT "disk in the usual manner."
350 RETURN
360 PRINT "APaint must be on the disk you use to"
370 PRINT "boot up the computer and must be left"
380 PRINT "in the built-in drive at all times."
390 PRINT "If you only have one disk drive, you"
400 PRINT "will have to save your pictures on"
410 PRINT "this boot disk. If it's been stripped"
420 PRINT "down you'll have room for five images."
430 PRINT "With two drives, you can put pictures"
440 PRINT "on any disk in the external drive."
450 PRINT
460 PRINT "For information on APaint, and how to"
470 PRINT "use the pictures you create in your"
480 PRINT "own programs, run APAINT.HINTS."
490 RETURN
500 '
510 ' If you find any bugs, or make improvements to
520 ' APaint, I'd like to hear from you. Write:
530 '
540 ' Colin French
550 ' 2144 Iris St.
560 ' Ottawa, Ontario
570 ' K2C 1B3
580 '
590 '
600 ' ---------NORMAL ENTRY POINT---------
610 ' This main program is chained into
620 ' place by the program 'APAINT' and
630 ' execution begins here.
640 '
650 ' GET DISK INFO & FILE LISTS
660 '
670 GOSUB 12600:DISK$=NAME$(0,NUMNAME%(0))
680 DSKBLK%=DSKBLK%(NUMNAME%(0))
690 GOSUB 12200
700 '
710 ' PROMPT TO CONTINUE
720 '
730 PENA 0:OUTLINE 0:BOX(35,162;261,172),1
740 PENA 30:PRINT AT(48,170);"Please double click here []"
750 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 750
760 PENA 0:BOX(86,172;214,182),1:PENA 30
770 IF X%>248 AND X%<262 AND Y%>161 AND Y%<171 THEN PRINT AT(108,180);"Thank you!":GOTO 790
780 PRINT AT(98,180);"Close enough..."
790 SLEEP 10^6:SCNCLR:PENA FCLR:DRAWMODE DRWMD
800 '
810 ' +--------------------+
820 ' | MAIN PROGRAM |
830 ' +--------------------+
840 '
860 QUIT=0
870 WHILE NOT(QUIT)
880 ASK MOUSE X%,Y%,B%
890 IF Y%<0 THEN GOSUB 6000 'cursor on menu bar
900 IF B%=0 THEN 960 'button not pressed
910 SSHAPE(0,0;304,189),UNDOBUF%() 'save screen
920 IF TOOL<7 THEN ON TOOL GOSUB 1000,1830,1940,1000,2340,2300:GOTO 960
930 IF TOOL<13 THEN ON TOOL-6 GOSUB 2600,2600,2800,2800,3030,3030:GOTO 960
940 IF TOOL<19 THEN ON TOOL-12 GOSUB 4250,4250,4340,4340,4240,4240:GOTO 960
950 IF TOOL<25 THEN ON TOOL-18 GOSUB 4670,4740,4890,5060,4240,5500
960 GET Z$:IF Z$<>"" THEN GOSUB 11100 'keyboard check
970 WEND
980 ' CLEAN UP BEFORE QUITTING
990 GOSUB 11000
992 END
1000 '
1010 ' +---------------------+
1020 ' | DRAWING TOOLS |
1030 ' +---------------------+
1040 '
1050 ' FREEHAND BRUSH
1060 X1%=X%:Y1%=Y%
1070 ASK MOUSE X%,Y%,B%:IF B%=0 THEN RETURN
1080 GOSUB 1100:GOTO 1060
1090 ' BRANCH TO BRUSHES
1100 ON BRUSH+1 GOSUB 1130,1160,1190,1230,1290,1360,1450,1480,1510,1540,1600,1690
1110 RETURN
1120 ' BRUSH 0: SINGLE POINT
1130 AREA(X1%,Y1% TO X1%,Y1% TO X%,Y%)
1140 RETURN
1150 ' BRUSH 1: DOUBLE POINT
1160 AREA(X1%,Y1% TO X1%+1,Y1% TO X%+1,Y% TO X%,Y%)
1170 RETURN
1180 ' BRUSH 2: SMALL SQUARE
1190 AREA(X1%,Y1% TO X1%+1,Y1% TO X%+1,Y% TO X%,Y%)
1200 AREA(X1%,Y1%+1 TO X1%+1,Y1%+1 TO X%+1,Y%+1 TO X%,Y%+1)
1210 RETURN
1220 ' BRUSH 3: SMALL CIRCLE
1230 AREA(X1%-1,Y1% TO X1%+2,Y1% TO X%+2,Y% TO X%-1,Y%)
1240 AREA(X1%-1,Y1%+1 TO X1%+2,Y1%+1 TO X%+2,Y%+1 TO X%-1,Y%+1)
1250 AREA(X1%,Y1%-1 TO X1%+1,Y1%-1 TO X%+1,Y%-1 TO X%,Y%-1)
1260 AREA(X1%,Y1%+2 TO X1%+1,Y1%+2 TO X%+1,Y%+2 TO X%,Y%+2)
1270 RETURN
1280 ' BRUSH 4: LARGE SQUARE
1290 AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+2 TO X%-2,Y%+2 TO X%-2,Y%-2)
1300 AREA(X1%-2,Y1%+2 TO X1%+2,Y1%+2 TO X%+2,Y%+2 TO X%-2,Y%+2)
1310 AREA(X1%+2,Y1%+2 TO X1%+2,Y1%-2 TO X%+2,Y%-2 TO X%+2,Y%+2)
1320 AREA(X1%+2,Y1%-2 TO X1%-2,Y1%-2 TO X%-2,Y%-2 TO X%+2,Y%-2)
1330 AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+2 TO X1%+2,Y1%+2 TO X1%+2,Y1%-2)
1340 RETURN
1350 ' BRUSH 5: LARGE CIRCLE
1360 AREA(X1%-3,Y1%-1 TO X1%-3,Y1%+2 TO X%-3,Y%+2 TO X%-3,Y%-1)
1370 AREA(X1%-1,Y1%+4 TO X1%+2,Y1%+4 TO X%+2,Y%+4 TO X%-1,Y%+4)
1380 AREA(X1%+4,Y1%+2 TO X1%+4,Y1%-1 TO X%+4,Y%-1 TO X%+4,Y%+2)
1390 AREA(X1%+2,Y1%-3 TO X1%-1,Y1%-3 TO X%-1,Y%-3 TO X%+2,Y%-3)
1400 AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+3 TO X%-2,Y%+3 TO X%-2,Y%-2)
1410 AREA(X1%+3,Y1%-2 TO X1%+3,Y1%+3 TO X%+3,Y%+3 TO X%+3,Y%-2)
1420 AREA(X1%-2,Y1%-2 TO X1%-2,Y1%+3 TO X1%+3,Y1%+3 TO X1%+3,Y1%-2)
1430 RETURN
1440 ' BRUSH 6: HORIZ LINE
1450 AREA(X1%-8,Y1% TO X1%+8,Y1% TO X%+8,Y% TO X%-8,Y%)
1460 RETURN
1470 ' BRUSH 7: DIAGONAL LINE
1480 AREA(X1%-3,Y1%+3 TO X1%+3,Y1%-3 TO X%+3,Y%-3 TO X%-3,Y%+3)
1490 RETURN
1500 ' BRUSH 8: VERTICAL LINE
1510 AREA(X1%,Y1%-7 TO X1%,Y1%+8 TO X%,Y%+8 TO X%,Y%-7)
1520 RETURN
1530 ' BRUSH 9: 3 SHORT BARS
1540 AREA(X1%-1,Y1%-7 TO X1%+1,Y1%-7 TO X%+1,Y%-7 TO X%-1,Y%-7)
1550 AREA(X1%-1,Y1% TO X1%+1,Y1% TO X%+1,Y% TO X%-1,Y%)
1560 AREA(X1%-1,Y1%+7 TO X1%+1,Y1%+7 TO X%+1,Y%+7 TO X%-1,Y%+7)
1570 RETURN
1580 ' BRUSH 10: SMALL RANDOM DOTS
1590 ' Note: Only draws at current position
1600 AREA(X%-2,Y%+1 TO X%-2,Y%+1 TO X%-2,Y%+1)
1610 AREA(X%-1,Y%-2 TO X%-1,Y%-2 TO X%-1,Y%-2)
1620 AREA(X%,Y% TO X%,Y% TO X%,Y%)
1630 AREA(X%,Y%+2 TO X%,Y%+2 TO X%,Y%+2)
1640 AREA(X%+2,Y%-1 TO X%+2,Y%-1 TO X%+2,Y%-1)
1650 AREA(X%+3,Y%+1 TO X%+3,Y%+1 TO X%+3,Y%+1)
1660 RETURN
1670 ' BRUSH 11: LARGE RANDOM DOTS
1680 ' Note: Only draws at current coords,
1690 AREA(X%-5,Y%-1 TO X%-5,Y%-1 TO X%-5,Y%-1)
1700 AREA(X%-4,Y%-3 TO X%-4,Y%-3 TO X%-4,Y%-3)
1710 AREA(X%-3,Y%+1 TO X%-3,Y%+1 TO X%-3,Y%+1)
1720 AREA(X%-2,Y%-2 TO X%-2,Y%-2 TO X%-2,Y%-2)
1730 AREA(X%-2,Y%+3 TO X%-2,Y%+3 TO X%-2,Y%+3)
1740 AREA(X%-1,Y%-4 TO X%-1,Y%-4 TO X%-1,Y%-4)
1750 AREA(X%-1,Y% TO X%-1,Y% TO X%-1,Y%)
1760 AREA(X%,Y%+4 TO X%,Y%+4 TO X%,Y%+4)
1770 AREA(X%+1,Y%-3 TO X%+1,Y%-3 TO X%+1,Y%-3)
1780 AREA(X%+1,Y%+2 TO X%+1,Y%+2 TO X%+1,Y%+2)
1790 AREA(X%+2,Y%-1 TO X%+2,Y%-1 TO X%+2,Y%-1)
1800 AREA(X%+4,Y%-2 TO X%+4,Y%-2 TO X%+4,Y%-2)
1810 AREA(X%+4,Y%+1 TO X%+4,Y%+1 TO X%+4,Y%+1)
1820 RETURN
1830 '
1840 ' SINGLE LINES
1850 '
1860 SSHAPE(0,0;304,189),TPIC%():DRAWMODE 2
1870 X1%=X%:Y1%=Y%
1880 X2%=X%:Y2%=Y%
1890 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 1920
1900 IF X%=X2% AND Y%=Y2% THEN 1890
1910 GSHAPE(0,0),TPIC%():DRAW(X1%,Y1% TO X%,Y%):GOTO 1880
1920 GSHAPE(0,0),TPIC%():DRAWMODE DRWMD
1930 GOSUB 1090:RETURN
1940 '
1950 ' CONNECTED LINES
1960 '
1970 IF CONFLG=1 THEN X%=XSAVE:Y%=YSAVE
1980 GOSUB 1860:XSAVE=X%:YSAVE=Y%
1990 CONFLG=1:RETURN
2300 '
2310 ' FILL AREA
2320 '
2330 PAINT(X%,Y%),1:RETURN
2340 '
2350 ' TEXT ENTRY
2360 '
2370 ASK MOUSE X%,Y%,B%:IF B%>0 THEN 2370
2380 X1%=X%-6:Y1%=Y%-1:OUTLINE 0:DRAWMODE DRWMD
2390 SSHAPE(0,0;304,189),TPIC%():S$="":NUMCHAR=0
2400 PRINT AT(X1%+NUMCHAR*8,Y1%);"_";
2410 ASK MOUSE X%,Y%,B%
2420 IF B%>0 THEN GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;:GOTO 2370
2430 IF Y%<0 THEN 2580
2440 GET Z$:IF Z$="" THEN 2410
2450 IF Z$<>CHR$(13) THEN 2460
2452 GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
2454 Y1%=Y1%+8:IF Y1%>186 THEN Y1%=Y1%-180
2456 GOTO 2390
2460 IF (Z$=CHR$(8) OR Z$=CHR$(127)) AND NUMCHAR>0 THEN 2550
2470 IF Z$<>CHR$(155) THEN 2500
2480 GET Z$:IF Z$="D" AND NUMCHAR>0 THEN 2550
2490 GOTO 2410
2500 IF ASC(Z$)<32 OR ASC(Z$)>127 THEN 2410
2510 IF X1%+NUMCHAR*8>295 THEN 2410
2520 S$=S$+Z$:NUMCHAR=NUMCHAR+1
2530 GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
2540 GOTO 2400
2550 NUMCHAR=NUMCHAR-1:S$=LEFT$(S$,NUMCHAR)
2560 GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
2570 GOTO 2400
2580 GSHAPE(0,0),TPIC%():PRINT AT(X1%,Y1%);S$;
2590 RETURN
2600 '
2610 ' BOX & FILLED BOX
2620 '
2630 SSHAPE(0,0;304,189),TPIC%()
2640 IF TOOL=7 THEN OUTLINE 1:DRAWMODE 2
2650 X1%=X%:Y1%=Y%
2660 X2%=X%:Y2%=Y%
2670 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 2720
2680 IF X%=X2% AND Y%=Y2% THEN 2670
2690 GSHAPE(0,0),TPIC%()
2700 IF TOOL=7 THEN BOX(X1%,Y1%;X%,Y%):GOTO 2660
2710 BOX(X1%,Y1%;X%,Y%),1:GOTO 2660
2720 IF TOOL=8 THEN RETURN
2730 GSHAPE(0,0),TPIC%():OUTLINE 0:DRAWMODE DRWMD
2740 XS%=X1%:YS%=Y1%:XE%=X%:YE%=Y%
2750 X%=XS%:Y%=YE%:GOSUB 1100
2760 X%=XE%:Y1%=YE%:GOSUB 1100
2770 X1%=XE%:Y%=YS%:GOSUB 1100
2780 X1%=XS%:Y1%=YS%:GOSUB 1100
2790 RETURN
2800 '
2810 ' OVAL & FILLED OVAL
2820 '
2830 SSHAPE(0,0;304,189),TPIC%():DRAWMODE 2
2840 X1%=X%:Y1%=Y%
2850 X2%=X%:Y2%=Y%
2860 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 2910
2870 IF X%=X2% AND Y%=Y2% THEN 2860
2880 GSHAPE(0,0),TPIC%()
2890 Y=ABS(Y1%-Y%):X=ABS(X1%-X%):IF X=0 THEN X=.0001
2900 CIRCLE(X1%,Y1%),X,Y/X:GOTO 2850
2910 HR=ABS(X%-X1%):VR=ABS(Y%-Y1%)
2920 GSHAPE(0,0),TPIC%():DRAWMODE DRWMD
2930 FOR N=0 TO 35
2940 CIR%(N*2)=XOFF(N)*HR+X1%
2950 CIR%(N*2+1)=YOFF(N)*VR+Y1%
2960 NEXT
2970 IF TOOL=10 THEN MAT AREA 36,CIR%():RETURN
2980 FOR N=0 TO 68 STEP 2
2990 X1%=CIR%(N):Y1%=CIR%(N+1):X%=CIR%(N+2):Y%=CIR%(N+3)
3000 GOSUB 1100:NEXT
3010 X1%=CIR%(70):Y1%=CIR%(71):X%=CIR%(0):Y%=CIR%(1)
3020 GOSUB 1100:RETURN
3030 '
3040 ' AUSTRALIA & FILLED AUSTRALIA
3050 '
3060 SSHAPE(0,0;304,189),TPIC%():BUTFLG=1:DRAWMODE 2
3070 PTS%(0)=X%:PTS%(1)=Y%:NUMPTS=0:TLR=2
3080 X2%=X%:Y2%=Y%
3090 ASK MOUSE X%,Y%,B%:IF B%=0 AND BUTFLG=1 THEN 3170
3100 IF B%=0 THEN 3090
3110 IF X%=X2% AND Y%=Y2% THEN 3090
3120 GSHAPE(0,0),TPIC%():BUTFLG=1:IF NUMPTS=0 THEN 3160
3130 FOR N=0 TO NUMPTS-1
3140 DRAW(PTS%(N*2),PTS%(N*2+1) TO PTS%(N*2+2),PTS%(N*2+3))
3150 NEXT
3160 DRAW(PTS%(NUMPTS*2),PTS%(NUMPTS*2+1) TO X%,Y%):GOTO 3080
3170 BUTFLG=0:NUMPTS=NUMPTS+1:IF NUMPTS>31 THEN NUMPTS=31:GOTO 3210
3180 PTS%(NUMPTS*2)=X%:PTS%(NUMPTS*2+1)=Y%
3190 IF ABS(X%-PTS%(0))>TLR THEN 3080
3200 IF ABS(Y%-PTS%(1))>TLR THEN 3080
3210 GSHAPE(0,0),TPIC%():DRAWMODE DRWMD
3220 IF NUMPTS<3 THEN RETURN
3230 IF TOOL=12 THEN MAT AREA NUMPTS,PTS%():RETURN
3240 FOR N=0 TO NUMPTS-1
3250 X1%=PTS%(N*2):Y1%=PTS%(N*2+1)
3260 X%=PTS%(N*2+2):Y%=PTS%(N*2+3)
3270 GOSUB 1100:NEXT
3280 X1%=PTS%(NUMPTS*2):Y1%=PTS%(NUMPTS*2+1)
3290 X%=PTS%(0):Y%=PTS%(1)
3300 GOSUB 1100:RETURN
4000 '
4010 ' +---------------------+
4020 ' | EDITING TOOLS |
4030 ' +---------------------+
4040 '
4050 ' DRAW AN EDIT FRAME
4060 '
4070 IF X%<0 THEN X%=0
4080 IF X%>302 THEN X%=302
4090 IF Y%<0 THEN Y%=0
4100 IF Y%>186 THEN Y%=186
4110 LINEPAT LINPAT%(1):EDSTX%=X%:EDSTY%=Y%
4120 DRAWMODE 2:OUTLINE 1
4130 X1%=X%:Y1%=Y%:BOX(EDSTX%,EDSTY%;X1%,Y1%)
4140 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 4210
4150 IF X%<0 THEN X%=0
4160 IF X%>302 THEN X%=302
4170 IF Y%<0 THEN Y%=0
4180 IF Y%>186 THEN Y%=186
4190 IF X1%=X% AND Y1%=Y% THEN 4140
4200 BOX(EDSTX%,EDSTY%;X1%,Y1%):GOTO 4130
4210 BOX(EDSTX%,EDSTY%;X1%,Y1%):DRAWMODE DRWMD
4220 OUTLINE 0:LINEPAT LINPAT%(0)
4230 EDENDX%=X1%:EDENDY%=Y1%
4240 RETURN
4250 '
4260 ' COPY OR CUT AN AREA
4270 '
4280 GOSUB 4050 'specify area
4290 SSHAPE(EDSTX%,EDSTY%;EDENDX%+1,EDENDY%+1),EDITBUF%()
4300 IF TOOL<>14 THEN CLPFLG=1:RETURN
4310 OUTLINE 0:PENA 0
4320 BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%),1
4330 PENA FCLR:CLPFLG=1:RETURN
4340 '
4350 ' PASTE OR USE AS BRUSH
4360 '
4370 IF CLPFLG=0 THEN RETURN
4380 SSHAPE(0,0;304,189),TPIC%()
4390 X1%=X%:Y1%=Y%:GSHAPE(X%,Y%),EDITBUF%()
4400 ASK MOUSE X%,Y%,B%:IF B%=0 THEN RETURN
4410 IF X%=X1% AND Y%=Y1% THEN 4400
4420 IF TOOL=15 THEN GSHAPE(0,0),TPIC%()
4430 GOTO 4390
4670 '
4680 ' INVERT COLORS
4690 '
4700 GOSUB 4050 'specify area
4710 IF EDSTX%=EDENDX% AND EDSTY%=EDENDY% THEN RETURN
4720 DRAWMODE 2:BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%),1
4730 DRAWMODE DRWMD:RETURN
4740 '
4750 ' FLIP HORIZ
4760 '
4770 GOSUB 4050
4780 IF EDSTX%=EDENDX% AND EDSTY%=EDENDY% THEN RETURN
4790 IF EDSTX%>EDENDX% THEN SWAP EDSTX%,EDENDX%
4800 T1%=INT((EDENDX%-EDSTX%+1)/2)-1
4810 IF T1%<0 THEN RETURN
4820 FOR Y=EDSTY% TO EDENDY%
4830 FOR N=0 TO T1%
4840 T2%=PIXEL(EDSTX%+N,Y)
4850 T3%=PIXEL(EDENDX%-N,Y)
4860 PENA T2%:DRAW(EDENDX%-N,Y)
4870 PENA T3%:DRAW(EDSTX%+N,Y)
4880 NEXT N,Y:PENA FCLR:RETURN
4890 '
4900 ' FLIP VERT
4910 '
4920 GOSUB 4050
4930 IF EDSTX%=EDENDX% AND EDSTY%=EDENDY% THEN RETURN
4940 IF EDSTY%>EDENDY% THEN SWAP EDSTY%,EDENDY%
4950 T1%=INT((EDENDY%-EDSTY%+1)/2)-1
4960 IF T1%<0 THEN RETURN
4970 FOR X=EDSTX% TO EDENDX%
4980 FOR N=0 TO T1%
4990 T2%=PIXEL(X,EDSTY%+N)
5000 T3%=PIXEL(X,EDENDY%-N)
5010 PENA T2%:DRAW(X,EDENDY%-N)
5020 PENA T3%:DRAW(X,EDSTY%+N)
5030 NEXT N,X
5040 PENA FCLR:RETURN
5050 '
5060 ' STRETCH AREA
5070 '
5080 GOSUB 4050 'specify original area
5090 DRAWMODE 2:OUTLINE 1:LINEPAT LINPAT%(1)
5100 BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%)
5110 LINEPAT LINPAT%(0):ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5110
5120 X1%=X%:Y1%=Y%:BOX(EDSTX%,EDSTY%;X1%,Y1%)
5130 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5160
5140 IF X1%=X% AND Y1%=Y% THEN 5130
5150 BOX(EDSTX%,EDSTY%;X1%,Y1%):GOTO 5120
5160 BOX(EDSTX%,EDSTY%;X1%,Y1%):LINEPAT LINPAT%(1)
5170 BOX(EDSTX%,EDSTY%;EDENDX%,EDENDY%)
5180 LINEPAT LINPAT%(0):DRAWMODE DRWMD:OUTLINE 0
5190 'now have both old and new boxes
5200 X%(0)=EDSTX%:X%(1)=EDENDX%
5210 X%(2)=EDSTX%:X%(3)=X1%
5220 Y%(0)=EDSTY%:Y%(1)=EDENDY%
5230 Y%(2)=EDSTY%:Y%(3)=Y1%
5240 X%(4)=X%(1)-X%(0):Y%(4)=Y%(1)-Y%(0)
5250 X%(5)=X%(3)-X%(2):Y%(5)=Y%(3)-Y%(2)
5260 IF ABS(X%(5))<=ABS(X%(4)) THEN 5290
5270 SWAP X%(0),X%(1):SWAP X%(2),X%(3)
5280 X%(4)=X%(4)*(-1):X%(5)=X%(5)*(-1)
5290 IF ABS(Y%(5))<=ABS(Y%(4)) THEN 5320
5300 SWAP Y%(0),Y%(1):SWAP Y%(2),Y%(3)
5310 Y%(4)=Y%(4)*(-1):Y%(5)=Y%(5)*(-1)
5320 XRATIO=X%(4)/X%(5):YRATIO=Y%(4)/Y%(5)
5330 'actual modification loop
5340 FOR N=0 TO X%(5) STEP SGN(X%(5))
5350 FOR N2=0 TO Y%(5) STEP SGN(Y%(5))
5360 PENA PIXEL(X%(0)+N*XRATIO,Y%(0)+N2*YRATIO)
5370 DRAW(X%(2)+N,Y%(2)+N2)
5380 NEXT N2,N
5390 RETURN
5500 '
5510 ' MAGNIFY AREA
5520 '
5530 DRAWMODE 2:LINEPAT LINPAT%(1)
5540 BOX(X%,Y%;X%+29,Y%+22):XS%=X%:YS%=Y%
5550 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5620
5560 IF X%>274 THEN X%=274
5570 IF X%<0 THEN X%=0
5580 IF Y%>165 THEN Y%=165
5590 IF Y%<0 THEN Y%=0
5600 IF X%=XS% AND Y%=YS% THEN 5550
5610 GSHAPE(0,0),TPIC%():GOTO 5540
5620 ' set up large view
5630 DRAWMODE 0:LINEPAT LINPAT%(0)
5640 GSHAPE(0,0),TPIC%():SSHAPE(XS%,YS%;XS%+30,YS%+23),SMLBUF%()
5650 SCNCLR:GSHAPE(259,22),SMLBUF%()
5660 PENO 29:OUTLINE 1:BOX(254,159;293,180)
5670 PENA 1:OUTLINE 0:PRINT AT(258,168);"Quit";AT(258,177);"Zoom"
5680 FOR Y=0 TO 7:FOR X=0 TO 3:PENA Y*4+X
5690 BOX(255+X*10,71+Y*10;262+X*10,78+Y*10),1:NEXT X,Y
5700 FOR Y=0 TO 22:FOR X=0 TO 29:PENA PIXEL(259+X,22+Y)
5710 BOX(X*8,Y*8;X*8+6,Y*8+6),1:NEXT X,Y
5720 PENA FCLR:Y=INT(FCLR/4):X=FCLR-Y*4
5730 OUTLINE 1:BOX(253+X*10,69+Y*10;264+X*10,80+Y*10):OUTLINE 0
5740 ' loop to modify points
5750 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 5750
5760 IF X%>239 THEN 5820
5770 IF X%<0 THEN X%=0
5780 IF Y%<0 THEN Y%=0
5790 IF Y%>183 THEN Y%=183
5800 X=INT(X%/8):Y=INT(Y%/8):DRAW(259+X,22+Y)
5810 BOX(X*8,Y*8;X*8+6,Y*8+6),1:GOTO 5750
5820 ' changing color?
5830 IF X%<255 OR X%>292 OR Y%<71 OR Y%>148 THEN 5900
5840 Y=INT(FCLR/4):X=FCLR-Y*4:OUTLINE 1:PENO 0
5850 BOX(253+X*10,69+Y*10;264+X*10,80+Y*10):PENO 29
5860 FCLR=INT((X%-255)/10)+INT((Y%-71)/10)*4
5870 Y=INT(FCLR/4):X=FCLR-Y*4
5880 BOX(253+X*10,69+Y*10;264+X*10,80+Y*10)
5890 OUTLINE 0:PENA FCLR:GOTO 5750
5900 ' quitting?
5910 IF X%<255 OR X%>292 OR Y%<160 OR Y%>179 THEN 5750
5920 SSHAPE(259,22;289,45),SMLBUF%()
5930 GSHAPE(0,0),TPIC%():GSHAPE(XS%,YS%),SMLBUF%():SSHAPE(0,0;304,189),TPIC%()
5940 OUTLINE 1:GOTO 6450
6000 '
6010 ' +-----------------------------+
6020 ' | MENU COMMAND ROUTINES |
6030 ' +-----------------------------+
6040 '
6050 ' ENTRY PREPARATION
6060 '
6070 SSHAPE(0,0;304,189),TPIC%()
6080 FOR N=0 TO 2:RGB N,ACLR%(N,0),ACLR%(N,1),ACLR%(N,2):NEXT
6090 FOR N=29 TO 31:RGB N,ACLR%(N,0),ACLR%(N,1),ACLR%(N,2):NEXT
6100 PATTERN 2,PAT0%():DRAWMODE 0:OUTLINE 1
6110 MENU=(-1):ITEM=(-1)
6120 CLRFLG=0:RNGFLG=0:CONFLG=0
6130 PENB 1:PENO 29
6140 '
6150 ' CHECK IF ON A MENU TITLE
6160 '
6170 ASK MOUSE X%,Y%,B%
6180 FOR N=0 TO NUMMENU
6190 IF X%<MTITLFT%(N) OR X%>MTITRGT%(N) THEN 6210
6200 MENU=N:N=NUMMENU
6210 NEXT
6220 IF MENU<0 THEN 6450 'not on a title
6230 '
6240 ' DISPLAY MENU, HIGHLIGHT ITEMS
6250 ' POINTED AT UNTIL SELECTION MADE
6260 ' OR CURSOR LEAVES MENU BOUNDRIES
6270 '
6280 GOSUB 6500 'display menu
6290 ASK MOUSE X%,Y%,B%
6300 IF B%>0 AND ITEM>(-1) THEN 8000 'selection made
6310 IF Y%<0 AND (X%<MTITLFT%(MENU)-1 OR X%>MTITRGT%(MENU)+1) THEN GSHAPE(0,0),TPIC%():GOTO 6450
6320 IF X%<MENULFT%(MENU) OR X%>MENURGT%(MENU) OR Y%>MENUBOT%(MENU) THEN GSHAPE(0,0),TPIC%():GOTO 6450
6330 TEMPITEM=(-1):FOR N=0 TO NUMITEM%(MENU)
6340 IF X%<ITEMLFT%(MENU,N) OR X%>ITEMRGT%(MENU,N) THEN 6370
6350 IF Y%<ITEMTOP%(MENU,N) OR Y%>ITEMBOT%(MENU,N) THEN 6370
6360 TEMPITEM=N:N=NUMITEM%(MENU)
6370 NEXT:IF TEMPITEM=ITEM THEN 6290 'no change
6380 IF ITEM>(-1) THEN GOSUB 7120 'un-highlight old item
6390 ITEM=TEMPITEM
6400 IF ITEM>(-1) THEN GOSUB 7120 'highlight new item
6410 GOTO 6290
6420 '
6430 ' EXIT CLEANUP
6440 '
6450 IF Y%<0 THEN 6100 'still on menu bar
6460 GOSUB 7190 'restore selected pattern
6470 GSHAPE(0,0),TPIC%():PENA FCLR:IF BCLR>=0 THEN PENB BCLR
6480 ASK MOUSE X%,Y%,B%:IF B%<>0 THEN 6480
6490 DRAWMODE DRWMD:OUTLINE 0:RETURN
6500 '
6510 '---------MENU DISPLAY ROUTINES---------
6520 '
6530 PENA 0:BOX(MENULFT%(MENU),0;MENURGT%(MENU),MENUBOT%(MENU)),1
6540 ON MENU GOTO 6590,6730,7070,7100
6550 '
6560 ' MENU 0: PROJECT
6570 GSHAPE(MENULFT%(0),0),PROJMENU%():RETURN
6580 '
6590 ' MENU 1: TOOLS
6600 GSHAPE(MENULFT%(1),0),TOOLMENU%()
6610 GOSUB 6620:GOSUB 6700:RETURN
6620 'tool indicator
6630 IF TOOL<13 THEN BOX(15+(TOOL-1)*23,16;34+(TOOL-1)*23,35):GOTO 6660
6640 IF TOOL<19 THEN BOX(15+(TOOL-13)*46,92;57+(TOOL-13)*46,111):GOTO 6660
6650 BOX(15+(TOOL-19)*46,115;57+(TOOL-19)*46,134)
6660 IF CLPFLG<>0 THEN RETURN
6670 OUTLINE 0:PENA 1:PATTERN 4,PAT6%()
6680 BOX(108,93;148,110),1:BOX(154,93;194,110),1:BOX(200,93;240,110),1
6690 OUTLINE 1:PATTERN 2,PAT0%():RETURN
6700 'brush indicator
6710 BOX(15+BRUSH*23,54;34+BRUSH*23,73):RETURN
6720 '
6730 ' MENU 1: COLOR
6740 GSHAPE(MENULFT%(2),0),CLR1MENU%()
6750 GSHAPE(MENULFT%(2)+74,16),CLR2MENU%()
6760 GSHAPE(MENULFT%(2)+202,16),CLR2MENU%()
6770 GOSUB 6790:GOSUB 6820:GOSUB 6880:GOSUB 6920
6780 GOSUB 6990:GOSUB 7040:RETURN
6790 'foreground color indicator
6800 Y=INT(FCLR/8):X=FCLR-Y*8
6810 BOX(81+X*9,14+Y*8;91+X*9,23+Y*8):RETURN
6820 'foreground color RGB bars
6830 OUTLINE 0:PENA 0:BOX(99,52;160,74),1
6840 PENA 29:PATTERN 2,PAT11%()
6850 ASK RGB FCLR,R%,G%,B%:BOX(99,52;99+R%*4,57),1
6860 BOX(99,60;99+G%*4,65),1:BOX(99,68;99+B%*4,73),1
6870 OUTLINE 1:PATTERN 2,PAT0%():RETURN
6880 'background color indicator
6890 IF BCLR<0 THEN BOX(281,14;290,47):RETURN
6900 Y=INT(BCLR/8):X=BCLR-Y*8
6910 BOX(209+X*9,14+Y*8;219+X*9,23+Y*8):RETURN
6920 'background color RGB bars
6930 OUTLINE 0:PENA 0:BOX(227,52;289,74),1
6940 PENA 29:PATTERN 2,PAT11%()
6950 IF BCLR<0 THEN PRINT AT(226,65);"TRNSPRNT":GOTO 6980
6960 ASK RGB BCLR,R%,G%,B%:BOX(227,52;227+R%*4,57),1
6970 BOX(227,60;227+G%*4,65),1:BOX(227,68;227+B%*4,73),1
6980 OUTLINE 1:PATTERN 2,PAT0%():RETURN
6990 'combined colors and pattern
7000 PENA 0:OUTLINE 0:BOX(173,36;198,59),1
7010 DRAWMODE DRWMD:GOSUB 7190:PENA FCLR:IF BCLR>=0 THEN PENB BCLR
7020 BOX(173,36;198,59),1:DRAWMODE 0:PENB 1
7030 OUTLINE 1:PATTERN 2,PAT0%():RETURN
7040 'pattern indicator
7050 BOX(92+PAT*18,87;109+PAT*18,105):RETURN
7060 '
7070 ' MENU 3: EXTRAS
7080 GSHAPE(MENULFT%(3),0),EXTRMENU%():RETURN
7090 '
7100 ' MENU 4: UNDO
7110 GSHAPE(MENULFT%(4),0),UNDOMENU%():RETURN
7120 '
7130 '------HIGHLIGHT/UNHIGHLIGHT ITEM-------
7140 '
7150 IF ITEMHIGH%(MENU,ITEM)=0 THEN 7180
7160 DRAWMODE 2:OUTLINE 0
7170 BOX(ITEMLFT%(MENU,ITEM),ITEMTOP%(MENU,ITEM)-1;ITEMRGT%(MENU,ITEM),ITEMBOT%(MENU,ITEM)+1),1
7180 DRAWMODE 0:RETURN
7190 '
7200 '------SET TO USER'S FILL PATTERN-------
7210 '
7220 ON PAT GOTO 7240,7250,7260,7270,7280,7290,7300,7310,7320,7330
7230 PATTERN 2,PAT0%():GOTO 7350
7240 PATTERN 4,PAT1%():GOTO 7350
7250 PATTERN 2,PAT2%():GOTO 7350
7260 PATTERN 2,PAT3%():GOTO 7350
7270 PATTERN 2,PAT4%():GOTO 7350
7280 PATTERN 4,PAT5%():GOTO 7350
7290 PATTERN 4,PAT6%():GOTO 7350
7300 PATTERN 4,PAT7%():GOTO 7350
7310 PATTERN 16,PAT8%():GOTO 7350
7320 PATTERN 16,PAT9%():GOTO 7350
7330 PATTERN 16,PAT10%():GOTO 7350
7350 RETURN
8000 '
8010 ' +----------------------------+
8020 ' | CARRY OUT MENU COMMAND |
8030 ' +----------------------------+
8040 '
8050 ON MENU GOTO 8540,8780,9900,10070
8060 '
8070 ' MENU 0: PROJECT
8080 '
8090 ON ITEM GOTO 8120,8260,8290,8480,8520
8100 ' NEW
8110 PROJNAME$="":GOTO 8480
8120 ' OPEN
8130 FT=1:FILACT$="Load"
8140 GOSUB 12800:GOSUB 11350
8150 IF ERRFLG<>0 OR S$="" THEN 8250
8160 PROJNAME$=S$
8170 N$=DISK$+PROJNAME$+SUFF$(FT)
8180 'future error handling
8190 BLOAD N$,VARPTR(TPIC%(0))
8200 'future error handling
8210 V=TPIC%(8981):IF V=0 THEN 8250
8220 FOR N=0 TO 31
8230 RGB N,TPIC%(8982+N*3),TPIC%(8983+N*3),TPIC%(8984+N*3)
8240 NEXT
8250 GOTO 6450
8260 ' SAVE
8270 IF PROJNAME$="" THEN 8290
8280 GSHAPE(0,0),TPIC%():GOTO 8420
8290 ' SAVE AS...
8300 FT=1:FILACT$="Save"
8310 GOSUB 12800:GOSUB 11350
8320 IF ERRFLG<>0 OR S$="" THEN 8460
8330 IF DSKBLK%>73 THEN 8380
8340 PENA 29:DRAWMODE 1
8350 PRINT AT(64,99);"*NOT ENOUGH ROOM ON DISK!*"
8360 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 8360
8370 DRAWMODE 0:GOTO 8460
8380 PROJNAME$=S$
8390 FOR N=0 TO 31
8400 ASK RGB N,TPIC%(8982+N*3),TPIC%(8983+N*3),TPIC%(8984+N*3)
8410 NEXT:TPIC%(8981)=1 'version number
8420 'future error handling
8430 N$=DISK$+PROJNAME$+SUFF$(FT)
8440 BSAVE N$,VARPTR(TPIC%(0)),36400
8450 'future error handling
8460 GOTO 6450
8480 ' CLEAR
8490 PENA 0:OUTLINE 0:BOX(0,0;304,189),1
8500 OUTLINE 1:SSHAPE(0,0;304,189),TPIC%()
8510 GOTO 6450
8520 ' QUIT
8530 QUIT=(-1):GOTO 6450
8540 '
8550 ' MENU 1: TOOLS
8560 '
8570 ON ITEM GOTO 8610,8640
8580 ' SELECT DRAWING TOOL
8590 PENO 1:GOSUB 6620:TOOL=INT((X%-14)/23)+1
8600 PENO 29:GOSUB 6620:GOTO 6310
8610 ' SELECT BRUSH
8620 PENO 1:GOSUB 6700:BRUSH=INT((X%-14)/23)
8630 PENO 29:GOSUB 6700:GOTO 6310
8640 ' SELECT EDITING TOOL
8642 PENO 1:GOSUB 6620:PENO 29
8644 T1%=INT((X%-14)/46)+INT((Y%-93)/23)*6+13
8646 IF CLPFLG=0 AND T1%>14 AND T1%<18 THEN GOSUB 6620:GOTO 6310
8648 IF T1%=23 THEN GOSUB 6620:GOTO 6310
8650 IF T1%=17 THEN 8660
8652 IF T1%=18 THEN 8700
8654 TOOL=T1%:GOSUB 6620:GOTO 6310
8660 ' save clipping to disk
8662 FT=3:FILACT$="Save"
8664 GOSUB 12800:GOSUB 11350
8666 IF ERRFLG<>0 OR S$="" THEN 8692
8668 N$=DISK$+S$+SUFF$(FT)
8670 ADD=VARPTR(EDITBUF%(0))
8672 T%(0)=PEEK_W(ADD+2):T%(1)=PEEK_W(ADD+4)
8674 T%(2)=(INT((T%(0)+15)/16)*T%(1)*5+4)*2
8676 IF DSKBLK%>INT(T%(2)/512)+3 THEN 8686
8678 PENA 29:PENB 1:DRAWMODE 1
8680 PRINT AT(64,99);"*NOT ENOUGH ROOM ON DISK!*"
8682 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 8682
8684 DRAWMODE 0:GOTO 8692
8686 'future error handling
8688 BSAVE N$,ADD,T%(2)
8690 'future error handling
8692 GSHAPE(0,0),TPIC%():GOSUB 6500:GOTO 6310
8700 'loading clipping from disk, then use paste tool.
8710 FT=3:FILACT$="Load"
8720 GOSUB 12800:GOSUB 11350
8730 IF ERRFLG<>0 OR S$="" THEN 8770
8740 N$=DISK$+S$+SUFF$(FT)
8742 'future error handling
8750 BLOAD N$,VARPTR(EDITBUF%(0))
8752 'future error handling
8760 CLPFLG=1:TOOL=15
8770 GSHAPE(0,0),TPIC%():GOSUB 6500:GOTO 6310
8780 '
8790 ' MENU 2: COLOR
8800 '
8810 ON ITEM+1 GOTO 8870,9040,9260,9300,9340,9510,9620,9690,9770,9770,9770,9820,9820,9820,9880
8820 GOTO 6310
8830 ' SAVE CURRENT COLORS
8840 FOR N=0 TO 31
8850 ASK RGB N,TCLR%(N,0),TCLR%(N,1),TCLR%(N,2)
8860 NEXT:RETURN
8870 ' COPY COLOR ROUTINES
8880 GOSUB 7120:PENA 0:DRAWMODE 1
8890 PRINT AT(19,27);"from?":GOSUB 7120
8900 IF RNGFLG>0 THEN RNGFLG=0:DRAWMODE 1:PRINT AT(19,35);"Range"
8910 DRAWMODE 0:CLRFLG=1:GOTO 6310
8920 'remember 'from' color
8930 IF C<0 THEN 6310
8940 STCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,27);"to? "
8950 DRAWMODE 0:CLRFLG=2:GOSUB 11170:GOTO 6310
8960 'carry out copy
8970 IF C<0 THEN 6310
8980 ENDCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,27);"Copy "
8990 DRAWMODE 0:CLRFLG=0:GOSUB 8830
9000 ASK RGB STCLR,R%,G%,B%:RGB ENDCLR,R%,G%,B%
9010 IF ENDCLR=FCLR THEN GOSUB 6820
9020 IF ENDCLR=BCLR THEN GOSUB 6920
9030 GOSUB 11170:GOTO 6310
9040 ' MAKE COLOR RANGE ROUTINES
9050 GOSUB 7120:PENA 0:DRAWMODE 1
9060 PRINT AT(19,35);"from?":GOSUB 7120
9070 IF CLRFLG>0 THEN CLRFLG=0:DRAWMODE 1:PRINT AT(19,27);"Copy "
9080 DRAWMODE 0:RNGFLG=1:GOTO 6310
9090 'remember 'from' color
9100 IF C<0 THEN 6310
9110 STCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,35);"to? "
9120 DRAWMODE 0:RNGFLG=2:GOSUB 11170:GOTO 6310
9130 'create range
9140 IF C<0 THEN 6310
9150 ENDCLR=C:PENA 0:DRAWMODE 1:PRINT AT(19,35);"Range"
9160 DRAWMODE 0:RNGFLG=0:GOSUB 8830
9170 IF ENDCLR<STCLR THEN SWAP ENDCLR,STCLR
9180 STP=ENDCLR-STCLR:IF STP<2 THEN 6310
9190 ASK RGB STCLR,SR%,SG%,SB%
9200 ASK RGB ENDCLR,ER%,EG%,EB%
9210 RINC=(ER%-SR%)/STP:GINC=(EG%-SG%)/STP:BINC=(EB%-SB%)/STP
9220 FOR N=1 TO STP-1
9230 R%=SR%+RINC*N:G%=SG%+GINC*N:B%=SB%+BINC*N
9240 RGB STCLR+N,R%,G%,B%:NEXT
9250 GOSUB 6820:GOSUB 6920:GOSUB 11170:GOTO 6310
9260 ' UNDO COLOR CHANGE
9270 FOR N=0 TO 31
9280 RGB N,TCLR%(N,0),TCLR%(N,1),TCLR%(N,2)
9290 NEXT:GOSUB 6820:GOSUB 6920:GOTO 6310
9300 ' SET NORMAL COLORS
9310 FOR N=0 TO 31
9320 RGB N,ACLR%(N,0),ACLR%(N,1),ACLR%(N,2)
9330 NEXT:GOSUB 6820:GOSUB 6920:GOTO 6310
9340 ' SAVE PALETTE
9350 FT=2:FILACT$="Save"
9360 GOSUB 12800:GOSUB 11350
9370 IF ERRFLG<>0 OR S$="" THEN 9490
9380 IF DSKBLK%>3 THEN 9430
9390 PENA 29:DRAWMODE 1
9400 PRINT AT(64,99);"*NOT ENOUGH ROOM ON DISK!*"
9410 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 9410
9420 DRAWMODE 0:GOTO 9490
9430 FOR N=0 TO 31
9440 ASK RGB N,CCLR%(N*3),CCLR%(N*3+1),CCLR%(N*3+2)
9450 NEXT:N$=DISK$+S$+SUFF$(FT)
9460 'future error handling
9470 BSAVE N$,VARPTR(CCLR%(0)),384
9480 'future error handling
9490 GOTO 6450
9510 ' LOAD PALETTE
9520 FT=2:FILACT$="Load"
9530 GOSUB 12800:GOSUB 11350
9540 IF ERRFLG<>0 OR S$="" THEN 9610
9550 N$=DISK$+S$+SUFF$(FT):GOSUB 8830
9560 'future error handling
9570 BLOAD N$,VARPTR(CCLR%(0))
9580 'future error handling
9590 FOR N=0 TO 31
9600 RGB N,CCLR%(N*3),CCLR%(N*3+1),CCLR%(N*3+2):NEXT
9610 GOTO 6450
9620 ' SET FOREGROUND COLOR
9630 C=INT((X%-81)/9)+INT((Y%-14)/8)*8
9640 ON CLRFLG GOTO 8920,8960
9650 ON RNGFLG GOTO 9090,9130
9660 PENO 0:GOSUB 6790:PENO 29
9670 FCLR=C:GOSUB 6790:GOSUB 6820:GOSUB 6990
9680 GOTO 6310
9690 ' SET BACKGROUND COLOR
9700 IF X%>280 THEN C=(-1):DRWMD=0:GOTO 9720
9710 C=INT((X%-209)/9)+INT((Y%-14)/8)*8:DRWMD=1
9720 ON CLRFLG GOTO 8920,8960
9730 ON RNGFLG GOTO 9090,9130
9740 PENO 0:GOSUB 6880:PENO 29
9750 BCLR=C:GOSUB 6880:GOSUB 6920:GOSUB 6990
9760 GOTO 6310
9770 ' MODIFY FOREGROUND RGB
9780 GOSUB 8830:ASK RGB FCLR,T%(0),T%(1),T%(2)
9790 T%(ITEM-8)=INT((X%-95)/4):RGB FCLR,T%(0),T%(1),T%(2)
9800 GOSUB 6820:IF BCLR=FCLR THEN GOSUB 6920
9810 GOTO 6310
9820 ' MODIFY BACKGROUND RGB
9830 IF BCLR<0 THEN 6310
9840 GOSUB 8830:ASK RGB BCLR,T%(0),T%(1),T%(2)
9850 T%(ITEM-11)=INT((X%-223)/4):RGB BCLR,T%(0),T%(1),T%(2)
9860 GOSUB 6920:IF FCLR=BCLR THEN GOSUB 6820
9870 GOTO 6310
9880 ' SELECT PATTERN
9890 PENO 0:GOSUB 7040:PAT=INT((X%-92)/18):PENO 29:GOSUB 7040:GOSUB 6990:GOTO 6310
9900 '
9910 ' MENU 3: EXTRAS
9920 '
9930 ON ITEM+1 GOTO 9950,10030
9940 GOTO 6310
9950 ' INFORMATION
9960 SCNCLR:GRAPHIC 0:DRAWMODE 1:PENA 1
9970 PRINT AT(1,1);"":GOSUB 100:PRINT:GOSUB 360:PRINT
9980 PRINT AT(1,23);"(Press a key or button to continue) ";
9990 GET Z$:IF Z$<>"" THEN 10010
10000 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 9990
10010 GRAPHIC 1:DRAWMODE 0
10020 GOTO 6450
10030 ' COPYING APAINT
10040 SCNCLR:GRAPHIC 0:DRAWMODE 1:PENA 1
10050 PRINT AT(1,1);"":GOSUB 160:PRINT:GOSUB 220:PRINT
10060 GOTO 9980
10070 '
10080 ' MENU 4: UNDO
10090 '
10100 GSHAPE(0,0),UNDOBUF%():SSHAPE(0,0;303,189),TPIC%()
10110 GOTO 6450
11000 '
11010 ' +------------------------------+
11020 ' | CLEAN UP BEFORE QUITTING |
11030 ' +------------------------------+
11040 '
11050 FOR N=0 TO 31
11060 RGB N,STDCLR%(N,0),STDCLR%(N,1),STDCLR%(N,2)
11070 NEXT
11080 CLOSE #1
11090 GRAPHIC 0
11100 '
11110 ' +----------------------+
11120 ' | KEYBOARD CHECK |
11130 ' +----------------------+
11140 '
11150 IF Z$=CHR$(27) THEN QUIT=(-1)
11160 RETURN
11170 '
11172 ' +-------------------------------+
11180 ' | WAIT FOR BUTTON RELEASE |
11182 ' +-------------------------------+
11184 '
11190 WHILE B%<>0:ASK MOUSE X%,Y%,B%:WEND:RETURN
11300 '
11310 ' +------------------------------+
11320 ' | FILE HANDLING ROUTINES |
11330 ' +------------------------------+
11340 '
11350 ' FILE I/O SELECTION
11360 '
11370 DRAWMODE 1:PENA 29:PENB 1:OUTLINE 0
11380 NUMCHAR=0:MAXCHAR=25:S$=""
11390 CURTIT=0:ERRFLG=0
11400 IF FILACT$="Load" THEN GOSUB 12400:GOTO 11420
11410 PRINT AT(64+NUMCHAR*8,99);"_";
11420 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 11790
11430 ' clicked on disk name?
11440 IF X%<16 OR X%>287 OR Y%<56 OR Y%>63 THEN 11600
11450 IF FT=0 THEN 11790
11460 T%(0)=FT:FT=0:N$=FILACT$:FILACT$="Load"
11470 PENA 1:BOX(64,56;287,63),1:BOX(64,77;264,117),1:PENA 0
11480 PRINT AT(16,99);"Disk:":PENA 29
11490 PRINT AT(64,99);"--Checking disks online--"
11500 GOSUB 12600:GOSUB 11350 'get info & select a disk
11510 IF ERRFLG<>0 THEN 11500 'must select something!
11520 DISK$=S$:DSKBLK%=DSKBLK%(CURTIT)
11530 FT=T%(0):FILACT$=N$:DRAWMODE 1
11540 PENA 0:PRINT AT(16,99);FILACT$;AT(64,62);DISK$
11550 PENA 1:BOX(64,77;264,117),1:PENA 29
11560 IF FILACT$<>"Load" THEN 11590
11570 PRINT AT(64,99);"----Reading Directory----"
11580 GOSUB 12200:PRINT AT(64,99);STRING$(25," ")
11590 GOTO 11350
11600 ' clicked on a scroll button?
11610 IF X%<277 OR X%>287 OR FILACT$<>"Load" THEN 11680
11620 IF Y%<84 OR Y%>94 THEN 11650
11630 CURTIT=CURTIT-1:IF CURTIT<0 THEN CURTIT=0
11640 SLEEP 10^6*.2:GOTO 11400
11650 IF Y%<100 OR Y%>110 THEN 11790
11660 CURTIT=CURTIT+1:IF CURTIT>NUMNAME%(FT) THEN CURTIT=NUMNAME%(FT)
11670 SLEEP 10^6*.2:GOTO 11400
11680 ' clicked on a file name?
11690 IF FILACT$<>"Load" THEN 11750
11700 IF X%<64 OR X%>263 OR Y%<77 OR Y%>116 THEN 11750
11710 T%(1)=CURTIT+INT((Y%-77)/8)-2
11720 IF T%(1)<0 THEN T%(1)=0
11730 IF T%(1)>NUMNAME%(FT) THEN T%(1)=NUMNAME%(FT)
11740 CURTIT=T%(1):GOTO 11400
11750 ' clicked on OK or CANCEL button?
11760 IF Y%<131 OR Y%>142 THEN 11790
11770 IF X%>59 AND X%<116 THEN ERRFLG=0:GOTO 11960
11780 IF X%>187 AND X%<244 THEN ERRFLG=1:GOTO 11960
11790 ' check for keyboard input
11800 GET Z$:IF Z$="" THEN 11420
11810 IF Z$=CHR$(13) THEN ERRFLG=0:GOTO 11960
11820 IF Z$=CHR$(27) THEN ERRFLG=1:GOTO 11960
11830 IF FILACT$="Load" THEN 11420
11840 IF (Z$=CHR$(8) OR Z$=CHR$(127)) AND NUMCHAR>0 THEN 11930
11850 IF Z$<>CHR$(155) THEN 11880
11860 GET Z$:IF Z$="D" AND NUMCHAR>0 THEN 11930
11870 GOTO 11420
11880 IF ASC(Z$)<32 OR ASC(Z$)>126 THEN 11420
11890 IF NUMCHAR>=MAXCHAR THEN 11420
11900 IF Z$=" " THEN Z$="."
11910 PRINT AT(64+NUMCHAR*8,99);Z$;
11920 S$=S$+Z$:NUMCHAR=NUMCHAR+1:GOTO 11410
11930 ' erase a character
11940 PRINT AT(64+NUMCHAR*8,99);" ";
11950 NUMCHAR=NUMCHAR-1:S$=LEFT$(S$,NUMCHAR):GOTO 11410
11960 ' clean up and exit
11970 DRAWMODE DRWMD:PENA FCLR:IF BCLR>(-1) THEN PENB BCLR
11980 IF FILACT$="Load" THEN S$=NAME$(FT,CURTIT)
11990 RETURN
12200 '
12210 ' READ FILE TITLES
12220 '
12230 OPEN "O",#15,DISK$+"TEMPFILE"
12240 Z$="LIST "+DISK$
12250 CMD #15:SHELL Z$:CLOSE #15
12260 FOR N=1 TO 3:NUMNAME%(N)=(-1):NEXT
12270 OPEN "I",#15,DISK$+"TEMPFILE"
12280 WHILE NOT(EOF(15)):LINE INPUT #15,Z$
12290 Z$=LEFT$(Z$,INSTR(Z$," ")-1)
12300 S$=RIGHT$(Z$,5)
12310 FOR N=1 TO 3:IF SUFF$(N)<>S$ THEN 12350
12320 NUMNAME%(N)=NUMNAME%(N)+1
12330 IF NUMNAME%(N)>30 THEN 12350
12340 NAME$(N,NUMNAME%(N))=LEFT$(Z$,LEN(Z$)-5)
12350 NEXT
12360 WEND
12370 CLOSE #15:CMD #1
12380 SCRATCH DISK$+"TEMPFILE"
12390 RETURN
12400 '
12410 ' DISPLAY FILE TITLES
12420 '
12430 PENA 1:OUTLINE 0
12440 BOX(64,77;264,117),1:PENA 29:PENB 1
12450 IF NUMNAME%(FT)>(-1) THEN 12480
12460 PRINT AT(64,99);"--No "+FILTYP$(FT)+" on disk--"
12470 GOTO 12540
12480 FOR N=(-2) TO 2
12490 IF N=0 THEN PENA 29 ELSE PENA 0
12500 IF CURTIT+N<0 THEN 12530
12510 IF CURTIT+N>NUMNAME%(FT) THEN 12530
12520 PRINT AT(64,99+N*8);NAME$(FT,CURTIT+N)
12530 NEXT:PENA 29
12540 RETURN
12600 '
12610 ' GET DISK INFO
12620 '
12630 OPEN "O",#15,"DF0:TEMPFILE"
12640 CMD #15:SHELL "INFO":CLOSE #15
12650 NUMNAME%(0)=(-1)
12660 FOR N=0 TO 9:NAME$(0,N)=":"
12670 DSKBLK%(N)=0:NEXT
12680 OPEN "I",#15,"DF0:TEMPFILE"
12690 LINE INPUT #15,Z$ 'throw away 1st blank line
12700 WHILE NOT(EOF(15))
12710 LINE INPUT #15,Z$:IF Z$="" THEN 12780
12720 IF LEFT$(Z$,2)<>"DF" THEN 12770
12730 NUMNAME%(0)=NUMNAME%(0)+1
12740 NAME$(0,NUMNAME%(0))=MID$(Z$,48,26)+":"
12750 DSKBLK%(NUMNAME%(0))=VAL(MID$(Z$,18,8))
12760 IF NAME$(0,NUMNAME%(0))=":" THEN NUMNAME%(0)=NUMNAME%(0)-1
12770 WEND
12780 CLOSE #15:CMD #1:SCRATCH "DF0:TEMPFILE"
12790 RETURN
12800 '
12810 ' DRAW FILE I/O BOX
12820 '
12830 PENA 1:PENO 29:OUTLINE 1:PATTERN 2,PAT0%()
12840 BOX(8,38;296,150),1:BOX(59,130;116,143)
12850 BOX(187,130;244,143):PENA 0:PENB 1:OUTLINE 0
12860 DRAW(60,144 TO 117,144 TO 117,131)
12870 DRAW(188,144 TO 245,144 TO 245,131)
12880 PRINT AT(80,139);"OK";AT(192,139);"CANCEL"
12890 DRAW(13,70 TO 290,70):DRAW(13,123 TO 290,123)
12900 PRINT AT(104,50);FILACT$;" ";FILTYP$(FT)
12910 PRINT AT(16,62);"Disk: "+DISK$
12920 PRINT AT(16,99);FILACT$;":"
12930 IF FILACT$<>"Load" THEN 12990
12940 OUTLINE 1:BOX(276,83;288,95):BOX(276,99;288,111):OUTLINE 0
12950 DRAW(277,96 TO 289,96 TO 289,84)
12960 DRAW(277,112 TO 289,112 TO 289,100)
12970 BOX(281,90;283,92),1:AREA(282,86 TO 279,89 TO 285,89)
12980 BOX(281,102;283,104),1:AREA(282,108 TO 279,105 TO 285,105)
12990 PENA 29:RETURN
13000 '
13010 ' DISK ERROR HANDLING
13020 '
13022 'Not used at present. Adding ON ERROR traps seems
13024 'to make ABasiC's/AmigaDOS' error handling even
13026 'worse than it already is. Therefore, APaint is
13028 'designed to avoid the more common file errors
13029 'without using error traps. (I hope!)
13030 PENA 30:BOX(8,10;295,66),1
13040 PENA 0:PRINT AT(88,24);"---DISK ERROR---"
13050 IF ERR=53 THEN PRINT AT(56,40);"Couldn't find that file.":GOTO 13100
13060 IF ERR=64 THEN PRINT AT(64,40);"Not a proper filename.":GOTO 13100
13070 IF STATUS=221 THEN PRINT AT(80,40);"That disk is full.":GOTO 13100
13090 PRINT AT(48,40);"A disk error has occurred."
13100 PRINT AT(16,56);"(Press a key or button to continue.)"
13110 ERRFLG=1
13120 GET Z$:IF Z$<>"" THEN 13140
13130 ASK MOUSE X%,Y%,B%:IF B%=0 THEN 13120
13140 IF ERL>12200 AND ERL<12380 THEN RESUME 12370
13150 RESUME NEXT